home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2.0 - Programmer's Utilities Power Pack / Delphi 2.0 Programmer's Utilities Power Pack.iso / e_to_l / htmlview / demounit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-09-15  |  6.5 KB  |  249 lines
  1. unit Demounit;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, ExtCtrls, Menus, Htmlview, StdCtrls, HtmlSubs;
  8.  
  9. const
  10.   MaxHistories = 6;  {size of History list}
  11. type
  12.   TForm1 = class(TForm)
  13.     OpenDialog: TOpenDialog;
  14.     MainMenu: TMainMenu;
  15.     Panel1: TPanel;
  16.     Panel2: TPanel;
  17.     Panel3: TPanel;
  18.     Viewer: THTMLViewer;
  19.     File1: TMenuItem;
  20.     Open: TMenuItem;
  21.     options1: TMenuItem;
  22.     ShowImages: TMenuItem;
  23.     Background1: TMenuItem;
  24.     clBtnFace1: TMenuItem;
  25.     clWindow1: TMenuItem;
  26.     Edit1: TEdit;
  27.     Reload: TButton;
  28.     BackButton: TButton;
  29.     FwdButton: TButton;
  30.     HistoryMenuItem: TMenuItem;
  31.     Exit: TMenuItem;
  32.     N1: TMenuItem;
  33.     procedure OpenFileClick(Sender: TObject);
  34.     procedure HotSpotChange(Sender: TObject; const URL: string);
  35.     procedure HotSpotClick(Sender: TObject; const URL: string;
  36.               var Handled: boolean);
  37.     procedure ShowImagesClick(Sender: TObject);
  38.     procedure ColorClick(Sender: TObject);
  39.     procedure ReloadClick(Sender: TObject);
  40.     procedure FormCreate(Sender: TObject);
  41.     procedure FormDestroy(Sender: TObject);
  42.     procedure FwdBackClick(Sender: TObject);
  43.     procedure HistoryClick(Sender: TObject);
  44.     procedure HistoryChange(Sender: TObject);
  45.     procedure ExitClick(Sender: TObject);
  46.   private
  47.     { Private declarations }
  48.     SndHandle : THandle;
  49.     PlaySound : function (lpszSoundName: PChar; uFlags: Word): Bool;
  50.     Histories: array[0..MaxHistories-1] of TMenuItem;
  51.   public
  52.     { Public declarations }
  53.   end;
  54.  
  55. var
  56.   Form1: TForm1;
  57.  
  58. implementation
  59.  
  60. {$R *.DFM}
  61.  
  62. procedure TForm1.FormCreate(Sender: TObject);
  63. var
  64.   I: integer;
  65. begin
  66. clBtnFace1.Checked := True;
  67. OpenDialog.InitialDir := ExtractFilePath(ParamStr(0));
  68.  
  69. {make sure mmsystem.dll exists before calling sndPlaySound}
  70. SndHandle := LoadLibrary('mmsystem.dll');
  71. if SndHandle >= 32 then
  72.   @PlaySound := GetProcAddress(SndHandle, 'sndPlaySound');
  73.  
  74. Viewer.HistoryMaxCount := MaxHistories;  {defines size of history list}
  75.  
  76. for I := 0 to MaxHistories-1 do
  77.   begin      {create the MenuItems for the history list}
  78.   Histories[I] := TMenuItem.Create(HistoryMenuItem);
  79.   HistoryMenuItem.Insert(I, Histories[I]);
  80.   with Histories[I] do
  81.     begin
  82.     Visible := False;
  83.     OnClick := HistoryClick;
  84.     Tag := I;
  85.     end;
  86.   end;
  87. if (ParamCount >= 1) then
  88.   Viewer.LoadFromFile(ParamStr(1));  {Parameter is file to load}
  89. end;
  90.  
  91. procedure TForm1.FormDestroy(Sender: TObject);
  92. begin
  93. if SndHandle >= 32 then FreeLibrary(SndHandle);
  94. end;
  95.  
  96. procedure TForm1.OpenFileClick(Sender: TObject);
  97. begin
  98. if Viewer.CurrentFile <> '' then
  99.   OpenDialog.InitialDir := ExtractFilePath(Viewer.CurrentFile);
  100. if OpenDialog.Execute then
  101.   begin
  102.   Viewer.LoadFromFile(OpenDialog.Filename);
  103.   Caption := Viewer.DocumentTitle;
  104.   Reload.Enabled := Viewer.CurrentFile <> '';
  105.   end;
  106. end;
  107.  
  108. procedure TForm1.HotSpotChange(Sender: TObject; const URL: string);
  109. {mouse moved over or away from a hot spot.  Change the status line}
  110. begin
  111. Panel1.Caption := URL;
  112. end;
  113.  
  114. procedure TForm1.HotSpotClick(Sender: TObject; const URL: string;
  115.           var Handled: boolean);
  116. {This routine handles what happens when a hot spot is clicked.  The assumption
  117.  is made that DOS filenames are being used. .EXE and .WAV files are handled
  118.  here, but other file types could be easily added.
  119.  
  120.  If the URL is handled here, set Handled to True.  If not handled here, set it
  121.  to False and ThtmlViewer will handle it.}
  122. const
  123.   snd_Async = $0001;  { play asynchronously }
  124. var
  125.   PC: array[0..255] of char;
  126.   S: string[70];
  127.   Ext: string[5];
  128.   I, J: integer;
  129.  
  130. begin
  131. Handled := False;
  132. I := Pos(':', URL);
  133. J := Pos('FILE:', UpperCase(URL));
  134. if (I <= 2) or (J > 0) then
  135.   begin                      {apparently the URL is a filename}
  136.   S := Viewer.HTMLExpandFileName(URL);
  137.   Ext := Uppercase(ExtractFileExt(S));
  138.   if Ext = '.WAV' then
  139.     begin
  140.     Handled := True;
  141.     if Assigned(PlaySound) then
  142.       PlaySound(StrPCopy(PC, S), snd_ASync);
  143.     end
  144.   else if Ext = '.EXE' then
  145.     begin
  146.     Handled := True;
  147.     WinExec(StrPCopy(PC, S), sw_Show);
  148.     end;
  149.   {else ignore other extensions}
  150.   Edit1.Text := URL;
  151.   end
  152. else Edit1.Text := URL;   {other protocall, mailto:, ftp:, etc.}
  153. end;
  154.  
  155. procedure TForm1.ShowImagesClick(Sender: TObject);
  156. {The Show Images menu item was clicked}
  157. begin
  158. With Viewer do
  159.   begin
  160.   ViewImages := not ViewImages;
  161.   (Sender as TMenuItem).Checked := ViewImages;
  162.   end;
  163. end;
  164.  
  165. procedure TForm1.ColorClick(Sender: TObject);
  166. {one of the color options on the menu was clicked}
  167. begin
  168. with Sender as TMenuItem do
  169.   begin
  170.   if Sender = clBtnFace1 then
  171.     begin
  172.     Viewer.Color := clBtnFace;
  173.     Checked := True;
  174.     clWindow1.Checked := False;
  175.     end
  176.   else
  177.     begin
  178.     Viewer.Color := clWindow;
  179.     Checked := True;
  180.     clBtnFace1.Checked := False;
  181.     end ;
  182.   end;
  183. end;
  184.  
  185. procedure TForm1.ReloadClick(Sender: TObject);
  186. {the Reload button was clicked}
  187. var
  188.   Pos: LongInt;
  189. begin
  190. with Viewer do
  191.   begin
  192.   Pos := Position;     {save the postion}
  193.   LoadFromFile(CurrentFile);   {load again}
  194.   Position := Pos;     {restore position}
  195.   end;
  196. end;
  197.  
  198. procedure TForm1.FwdBackClick(Sender: TObject);
  199. {Either the Forward or Back button was clicked}
  200. begin
  201. with Viewer do
  202.   begin
  203.   if Sender = BackButton then
  204.     HistoryIndex := HistoryIndex +1
  205.   else
  206.     HistoryIndex := HistoryIndex -1;
  207.   end;
  208. end;
  209.  
  210. procedure TForm1.HistoryChange(Sender: TObject);
  211. {This event occurs when something changes history list}
  212. var
  213.   I: integer;
  214. begin
  215. with Sender as ThtmlViewer do
  216.   begin
  217.   {check to see which buttons are to be enabled}
  218.   FwdButton.Enabled := HistoryIndex > 0;
  219.   BackButton.Enabled := HistoryIndex < History.Count-1;
  220.  
  221.   {Enable and caption the appropriate history menuitems}
  222.   HistoryMenuItem.Visible := History.Count > 0;
  223.   for I := 0 to MaxHistories-1 do
  224.     with Histories[I] do
  225.       if I < History.Count then
  226.         Begin
  227.         Caption := History.Strings[I];
  228.         Visible := True;
  229.         Checked := I = HistoryIndex;
  230.         end
  231.       else Histories[I].Visible := False; 
  232.   Caption := DocumentTitle;    {keep the caption updated}
  233.   end;
  234. end;
  235.  
  236. procedure TForm1.HistoryClick(Sender: TObject);
  237. {A history list menuitem got clicked on}
  238. begin
  239.   {Changing the HistoryIndex loads and positions the appropriate document}
  240.   Viewer.HistoryIndex := (Sender as TMenuItem).Tag;
  241. end;
  242.  
  243. procedure TForm1.ExitClick(Sender: TObject);
  244. begin
  245. Close;
  246. end;
  247.  
  248. end.
  249.